home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Doc / AxCtrls.int < prev    next >
Encoding:
Text File  |  2001-05-22  |  25.4 KB  |  629 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       ActiveX Controls Unit                           }
  6. {                                                       }
  7. {  Copyright (c) 1995-2001 Borland Software Corporation }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit AxCtrls;
  12.  
  13. {$WARN SYMBOL_PLATFORM OFF}
  14.  
  15. {$T-,H+,X+}
  16.  
  17. interface
  18.  
  19. (*$HPPEMIT '' *)
  20. (*$HPPEMIT '#include <objsafe.h>' *)
  21. (*$HPPEMIT '#include <ocidl.h>' *)
  22. (*$HPPEMIT '' *)
  23.  
  24. uses
  25.   Variants, Windows, Messages, ActiveX, SysUtils, ComObj, Classes, Graphics,
  26.   Controls, Forms, ExtCtrls, StdVCL;
  27.  
  28. const
  29.   { Delphi property page CLSIDs }
  30.   Class_DColorPropPage: TGUID = '{5CFF5D59-5946-11D0-BDEF-00A024D1875C}';
  31.   Class_DFontPropPage: TGUID = '{5CFF5D5B-5946-11D0-BDEF-00A024D1875C}';
  32.   Class_DPicturePropPage: TGUID = '{5CFF5D5A-5946-11D0-BDEF-00A024D1875C}';
  33.   Class_DStringPropPage: TGUID = '{F42D677E-754B-11D0-BDFB-00A024D1875C}';
  34.  
  35. type
  36.   TOleStream = class(TStream)
  37.   protected
  38.     function GetIStream: IStream;
  39.   public
  40.     constructor Create(const Stream: IStream);
  41.     function Read(var Buffer; Count: Longint): Longint; override;
  42.     function Write(const Buffer; Count: Longint): Longint; override;
  43.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  44.   end;
  45.  
  46.   TConnectionPoints = class;
  47.  
  48.   TConnectionKind = (ckSingle, ckMulti);
  49.   {$EXTERNALSYM TConnectionKind}
  50.  
  51.   TConnectionPoint = class(TContainedObject, IConnectionPoint)
  52.   protected
  53.     { IConnectionPoint }
  54.     function GetConnectionInterface(out iid: TIID): HResult; stdcall;
  55.     function GetConnectionPointContainer(
  56.       out cpc: IConnectionPointContainer): HResult; stdcall;
  57.     function Advise(const unkSink: IUnknown; out dwCookie: Longint): HResult; stdcall;
  58.     function Unadvise(dwCookie: Longint): HResult; stdcall;
  59.     function EnumConnections(out enumconn: IEnumConnections): HResult; stdcall;
  60.   public
  61.     constructor Create(Container: TConnectionPoints;
  62.       const IID: TGUID; Kind: TConnectionKind; OnConnect: TConnectEvent);
  63.     property SinkList : TList;
  64.     destructor Destroy; override;
  65.   end;
  66.   {$EXTERNALSYM TConnectionPoint}
  67.  
  68.   TConnectionPoints = class{IConnectionPointContainer}
  69.   protected
  70.     { IConnectionPointContainer }
  71.     function EnumConnectionPoints(
  72.       out enumconn: IEnumConnectionPoints): HResult; stdcall;
  73.     function FindConnectionPoint(const iid: TIID;
  74.       out cp: IConnectionPoint): HResult; stdcall;
  75.   public
  76.     constructor Create(const AController: IUnknown);
  77.     destructor Destroy; override;
  78.     function CreateConnectionPoint(const IID: TGUID; Kind: TConnectionKind;
  79.       OnConnect: TConnectEvent): TConnectionPoint;
  80.     property Controller: IUnknown;
  81.   end;
  82.   {$EXTERNALSYM TConnectionPoints}
  83.  
  84.   TDefinePropertyPage = procedure(const GUID: TGUID) of object;
  85.  
  86.   TActiveXControlFactory = class;
  87.   {$EXTERNALSYM TActiveXControlFactory}
  88.  
  89.   IAmbientDispatch = dispinterface
  90.     ['{00020400-0000-0000-C000-000000000046}']
  91.     property BackColor: Integer dispid DISPID_AMBIENT_BACKCOLOR;
  92.     property DisplayName: WideString dispid DISPID_AMBIENT_DISPLAYNAME;
  93.     property Font: IFontDisp dispid DISPID_AMBIENT_FONT;
  94.     property ForeColor: Integer dispid DISPID_AMBIENT_FORECOLOR;
  95.     property LocaleID: Integer dispid DISPID_AMBIENT_LOCALEID;
  96.     property MessageReflect: WordBool dispid DISPID_AMBIENT_MESSAGEREFLECT;
  97.     property ScaleUnits: WideString dispid DISPID_AMBIENT_SCALEUNITS;
  98.     property TextAlign: Smallint dispid DISPID_AMBIENT_TEXTALIGN;
  99.     property UserMode: WordBool dispid DISPID_AMBIENT_USERMODE;
  100.     property UIDead: WordBool dispid DISPID_AMBIENT_UIDEAD;
  101.     property ShowGrabHandles: WordBool dispid DISPID_AMBIENT_SHOWGRABHANDLES;
  102.     property ShowHatching: WordBool dispid DISPID_AMBIENT_SHOWHATCHING;
  103.     property DisplayAsDefault: WordBool dispid DISPID_AMBIENT_DISPLAYASDEFAULT;
  104.     property SupportsMnemonics: WordBool dispid DISPID_AMBIENT_SUPPORTSMNEMONICS;
  105.     property AutoClip: WordBool dispid DISPID_AMBIENT_AUTOCLIP;
  106.   end;
  107.  
  108.   TActiveXControl = class(TAutoObject,
  109.     IConnectionPointContainer,
  110.     IDataObject,
  111.     IObjectSafety,
  112.     IOleControl,
  113.     IOleInPlaceActiveObject,
  114.     IOleInPlaceObject,
  115.     IOleObject,
  116.     IPerPropertyBrowsing,
  117.     IPersistPropertyBag,
  118.     IPersistStorage,
  119.     IPersistStreamInit,
  120.     IQuickActivate,
  121.     ISimpleFrameSite,
  122.     ISpecifyPropertyPages,
  123.     IViewObject,
  124.     IViewObject2)
  125.  
  126.   protected
  127.     { Renamed methods }
  128.     function IPersistPropertyBag.InitNew = PersistPropBagInitNew;
  129.     function IPersistPropertyBag.Load = PersistPropBagLoad;
  130.     function IPersistPropertyBag.Save = PersistPropBagSave;
  131.     function IPersistStreamInit.Load = PersistStreamLoad;
  132.     function IPersistStreamInit.Save = PersistStreamSave;
  133.     function IPersistStorage.InitNew = PersistStorageInitNew;
  134.     function IPersistStorage.Load = PersistStorageLoad;
  135.     function IPersistStorage.Save = PersistStorageSave;
  136.     function IViewObject2.GetExtent = ViewObjectGetExtent;
  137.     { IPersist }
  138.     function GetClassID(out classID: TCLSID): HResult; stdcall;
  139.     { IPersistPropertyBag }
  140.     function PersistPropBagInitNew: HResult; stdcall;
  141.     function PersistPropBagLoad(const pPropBag: IPropertyBag;
  142.       const pErrorLog: IErrorLog): HResult; stdcall;
  143.     function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL;
  144.       fSaveAllProperties: BOOL): HResult; stdcall;
  145.     { IPersistStreamInit }
  146.     function IsDirty: HResult; stdcall;
  147.     function PersistStreamLoad(const stm: IStream): HResult; stdcall;
  148.     function PersistStreamSave(const stm: IStream;
  149.       fClearDirty: BOOL): HResult; stdcall;
  150.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
  151.     function InitNew: HResult; stdcall;
  152.     { IPersistStorage }
  153.     function PersistStorageInitNew(const stg: IStorage): HResult; stdcall;
  154.     function PersistStorageLoad(const stg: IStorage): HResult; stdcall;
  155.     function PersistStorageSave(const stgSave: IStorage;
  156.       fSameAsLoad: BOOL): HResult; stdcall;
  157.     function SaveCompleted(const stgNew: IStorage): HResult; stdcall;
  158.     function HandsOffStorage: HResult; stdcall;
  159.     { IObjectSafety }
  160.     function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
  161.       pdwEnabledOptions: PDWORD): HResult; virtual; stdcall;
  162.     function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
  163.       dwEnabledOptions: DWORD): HResult; virtual; stdcall;
  164.     { IOleObject }
  165.     function SetClientSite(const clientSite: IOleClientSite): HResult;
  166.       stdcall;
  167.     function GetClientSite(out clientSite: IOleClientSite): HResult;
  168.       stdcall;
  169.     function SetHostNames(szContainerApp: POleStr;
  170.       szContainerObj: POleStr): HResult; stdcall;
  171.     function Close(dwSaveOption: Longint): HResult; stdcall;
  172.     function SetMoniker(dwWhichMoniker: Longint; const mk: IMoniker): HResult;
  173.       stdcall;
  174.     function GetMoniker(dwAssign: Longint; dwWhichMoniker: Longint;
  175.       out mk: IMoniker): HResult; stdcall;
  176.     function InitFromData(const dataObject: IDataObject; fCreation: BOOL;
  177.       dwReserved: Longint): HResult; stdcall;
  178.     function GetClipboardData(dwReserved: Longint;
  179.       out dataObject: IDataObject): HResult; stdcall;
  180.     function DoVerb(iVerb: Longint; msg: PMsg; const activeSite: IOleClientSite;
  181.       lindex: Longint; hwndParent: HWND; const posRect: TRect): HResult;
  182.       stdcall;
  183.     function EnumVerbs(out enumOleVerb: IEnumOleVerb): HResult; stdcall;
  184.     function Update: HResult; stdcall;
  185.     function IsUpToDate: HResult; stdcall;
  186.     function GetUserClassID(out clsid: TCLSID): HResult; stdcall;
  187.     function GetUserType(dwFormOfType: Longint; out pszUserType: POleStr): HResult;
  188.       stdcall;
  189.     function SetExtent(dwDrawAspect: Longint; const size: TPoint): HResult;
  190.       stdcall;
  191.     function GetExtent(dwDrawAspect: Longint; out size: TPoint): HResult;
  192.       stdcall;
  193.     function Advise(const advSink: IAdviseSink; out dwConnection: Longint): HResult;
  194.       stdcall;
  195.     function Unadvise(dwConnection: Longint): HResult; stdcall;
  196.     function EnumAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  197.     function GetMiscStatus(dwAspect: Longint; out dwStatus: Longint): HResult;
  198.       stdcall;
  199.     function SetColorScheme(const logpal: TLogPalette): HResult; stdcall;
  200.     { IOleControl }
  201.     function GetControlInfo(var ci: TControlInfo): HResult; stdcall;
  202.     function OnMnemonic(msg: PMsg): HResult; stdcall;
  203.     function OnAmbientPropertyChange(dispid: TDispID): HResult; stdcall;
  204.     function FreezeEvents(bFreeze: BOOL): HResult; stdcall;
  205.     { IOleWindow }
  206.     function GetWindow(out wnd: HWnd): HResult; stdcall;
  207.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  208.     { IOleInPlaceObject }
  209.     function InPlaceDeactivate: HResult; stdcall;
  210.     function UIDeactivate: HResult; stdcall;
  211.     function SetObjectRects(const rcPosRect: TRect;
  212.       const rcClipRect: TRect): HResult; stdcall;
  213.     function ReactivateAndUndo: HResult; stdcall;
  214.     { IOleInPlaceActiveObject }
  215.     function TranslateAccelerator(var msg: TMsg): HResult; stdcall;
  216.     function OnFrameWindowActivate(fActivate: BOOL): HResult; stdcall;
  217.     function OnDocWindowActivate(fActivate: BOOL): HResult; stdcall;
  218.     function ResizeBorder(const rcBorder: TRect; const uiWindow: IOleInPlaceUIWindow;
  219.       fFrameWindow: BOOL): HResult; stdcall;
  220.     function EnableModeless(fEnable: BOOL): HResult; stdcall;
  221.     { IViewObject }
  222.     function Draw(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  223.       ptd: PDVTargetDevice; hicTargetDev: HDC; hdcDraw: HDC;
  224.       prcBounds: PRect; prcWBounds: PRect; fnContinue: TContinueFunc;
  225.       dwContinue: Longint): HResult; stdcall;
  226.     function GetColorSet(dwDrawAspect: Longint; lindex: Longint;
  227.       pvAspect: Pointer; ptd: PDVTargetDevice; hicTargetDev: HDC;
  228.       out colorSet: PLogPalette): HResult; stdcall;
  229.     function Freeze(dwDrawAspect: Longint; lindex: Longint; pvAspect: Pointer;
  230.       out dwFreeze: Longint): HResult; stdcall;
  231.     function Unfreeze(dwFreeze: Longint): HResult; stdcall;
  232.     function SetAdvise(aspects: Longint; advf: Longint;
  233.       const advSink: IAdviseSink): HResult; stdcall;
  234.     function GetAdvise(pAspects: PLongint; pAdvf: PLONGINT;
  235.       out advSink: IAdviseSink): HResult; stdcall;
  236.     { IViewObject2 }
  237.     function ViewObjectGetExtent(dwDrawAspect: Longint; lindex: Longint;
  238.       ptd: PDVTargetDevice; out size: TPoint): HResult; stdcall;
  239.     { IPerPropertyBrowsing }
  240.     function GetDisplayString(dispid: TDispID; out bstr: WideString): HResult; stdcall;
  241.     function MapPropertyToPage(dispid: TDispID; out clsid: TCLSID): HResult; stdcall;
  242.     function GetPredefinedStrings(dispid: TDispID; out caStringsOut: TCAPOleStr;
  243.       out caCookiesOut: TCALongint): HResult; stdcall;
  244.     function GetPredefinedValue(dispid: TDispID; dwCookie: Longint;
  245.       out varOut: OleVariant): HResult; stdcall;
  246.     { ISpecifyPropertyPages }
  247.     function GetPages(out pages: TCAGUID): HResult; stdcall;
  248.     { ISimpleFrameSite }
  249.     function PreMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  250.       out res: Integer; out Cookie: Longint): HResult; stdcall;
  251.     function PostMessageFilter(wnd: HWnd; msg, wp, lp: Integer;
  252.       out res: Integer; Cookie: Longint): HResult; stdcall;
  253.     { IQuickActivate }
  254.     function QuickActivate(var qaCont: tagQACONTAINER; var qaCtrl: tagQACONTROL): HResult; stdcall;
  255.     function SetContentExtent(const sizel: TPoint): HResult; stdcall;
  256.     function GetContentExtent(out sizel: TPoint): HResult; stdcall;
  257.     { IDataObject }
  258.     function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
  259.       HResult; stdcall;
  260.     function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
  261.       HResult; stdcall;
  262.     function QueryGetData(const formatetc: TFormatEtc): HResult;
  263.       stdcall;
  264.     function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
  265.       out formatetcOut: TFormatEtc): HResult; stdcall;
  266.     function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
  267.       fRelease: BOOL): HResult; stdcall;
  268.     function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
  269.       IEnumFormatEtc): HResult; stdcall;
  270.     function DAdvise(const formatetc: TFormatEtc; advf: Longint;
  271.       const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
  272.     function DUnadvise(dwConnection: Longint): HResult; stdcall;
  273.     function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
  274.       stdcall;
  275.     { Standard properties }
  276.     function Get_BackColor: Integer; safecall;
  277.     function Get_Caption: WideString; safecall;
  278.     function Get_Enabled: WordBool; safecall;
  279.     function Get_Font: Font; safecall;
  280.     function Get_ForeColor: Integer; safecall;
  281.     function Get_HWnd: Integer; safecall;
  282.     function Get_TabStop: WordBool; safecall;
  283.     function Get_Text: WideString; safecall;
  284.     procedure Set_BackColor(Value: Integer); safecall;
  285.     procedure Set_Caption(const Value: WideString); safecall;
  286.     procedure Set_Enabled(Value: WordBool); safecall;
  287.     procedure Set_Font(const Value: Font); safecall;
  288.     procedure Set_ForeColor(Value: Integer); safecall;
  289.     procedure Set_TabStop(Value: WordBool); safecall;
  290.     procedure Set_Text(const Value: WideString); safecall;
  291.     { Standard event handlers }
  292.     procedure StdClickEvent(Sender: TObject);
  293.     procedure StdDblClickEvent(Sender: TObject);
  294.     procedure StdKeyDownEvent(Sender: TObject; var Key: Word;
  295.       Shift: TShiftState);
  296.     procedure StdKeyPressEvent(Sender: TObject; var Key: Char);
  297.     procedure StdKeyUpEvent(Sender: TObject; var Key: Word;
  298.       Shift: TShiftState);
  299.     procedure StdMouseDownEvent(Sender: TObject; Button: TMouseButton;
  300.       Shift: TShiftState; X, Y: Integer);
  301.     procedure StdMouseMoveEvent(Sender: TObject; Shift: TShiftState;
  302.       X, Y: Integer);
  303.     procedure StdMouseUpEvent(Sender: TObject; Button: TMouseButton;
  304.       Shift: TShiftState; X, Y: Integer);
  305.     { Helper methods }
  306.     function InPlaceActivate(ActivateUI: Boolean): HResult;
  307.     procedure ShowPropertyDialog;
  308.     procedure SetInPlaceSite(const NewInPlaceSite: IOleInPlaceSite);
  309.     { Overrideable methods }
  310.     procedure DefinePropertyPages(
  311.       DefinePropertyPage: TDefinePropertyPage); virtual;
  312.     function GetPropertyString(DispID: Integer;
  313.       var S: string): Boolean; virtual;
  314.     function GetPropertyStrings(DispID: Integer;
  315.       Strings: TStrings): Boolean; virtual;
  316.     procedure GetPropertyValue(DispID, Cookie: Integer;
  317.       var Value: OleVariant); virtual;
  318.     procedure GetPropFromBag(const PropName: WideString; DispatchID: Integer;
  319.       PropBag: IPropertyBag; ErrorLog: IErrorLog); virtual;
  320.     procedure InitializeControl; virtual;
  321.     procedure LoadFromStream(const Stream: IStream); virtual;
  322.     procedure PerformVerb(Verb: Integer); virtual;
  323.     procedure PutPropInBag(const PropName: WideString; DispatchID: Integer;
  324.       PropBag: IPropertyBag); virtual;
  325.     procedure SaveToStream(const Stream: IStream); virtual;
  326.     procedure WndProc(var Message: TMessage); virtual;
  327.     property ConnectionPoints: TConnectionPoints;
  328.   public
  329.     destructor Destroy; override;
  330.     procedure Initialize; override;
  331.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  332.     procedure PropChanged(const PropertyName: WideString); overload;
  333.     procedure PropChanged(DispID: TDispID); overload;
  334.     function PropRequestEdit(const PropertyName: WideString): Boolean; overload;
  335.     function PropRequestEdit(DispID: TDispID): Boolean; overload;
  336.     property ClientSite: IOleClientSite;
  337.     property InPlaceSite: IOleInPlaceSite;
  338.     property Control: TWinControl;
  339.   end;
  340.   {$EXTERNALSYM TActiveXControl}
  341.  
  342.   TActiveXControlClass = class of TActiveXControl;
  343.   {$EXTERNALSYM TActiveXControlClass}
  344.  
  345.   TActiveXControlFactory = class(TAutoObjectFactory)
  346.   protected
  347.     function GetLicenseFileName: string; virtual;
  348.     function HasMachineLicense: Boolean; override;
  349.   public
  350.     constructor Create(ComServer: TComServerObject;
  351.       ActiveXControlClass: TActiveXControlClass;
  352.       WinControlClass: TWinControlClass; const ClassID: TGUID;
  353.       ToolboxBitmapID: Integer; const LicStr: string; MiscStatus: Integer;
  354.       ThreadingModel: TThreadingModel = tmSingle);
  355.     destructor Destroy; override;
  356.     procedure AddVerb(Verb: Integer; const VerbName: string);
  357.     procedure UpdateRegistry(Register: Boolean); override;
  358.     property MiscStatus: Integer;
  359.     property ToolboxBitmapID: Integer;
  360.     property WinControlClass: TWinControlClass;
  361.   end;
  362.   {$EXTERNALSYM TActiveXControlFactory}
  363.  
  364.   { ActiveFormControl }
  365.  
  366.   TActiveFormControl = class(TActiveXControl, IVCLComObject)
  367.   protected
  368.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  369.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  370.   public
  371.     procedure FreeOnRelease;
  372.     procedure InitializeControl; override;
  373.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  374.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
  375.       override;
  376.     function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override;
  377.   end;
  378.   {$EXTERNALSYM TActiveFormControl}
  379.  
  380.   { ActiveForm }
  381.  
  382.   TActiveForm = class(TCustomActiveForm)
  383.   protected
  384.     procedure DoDestroy; override;
  385.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); virtual;
  386.     procedure EventSinkChanged(const EventSink: IUnknown); virtual;
  387.     procedure Initialize; virtual;
  388.   public
  389.     property ActiveFormControl: TActiveFormControl;
  390.   end;
  391.   {$EXTERNALSYM TActiveForm}
  392.  
  393.   TActiveFormClass = class of TActiveForm;
  394.   {$EXTERNALSYM TActiveFormClass}
  395.  
  396.   { ActiveFormFactory }
  397.  
  398.   TActiveFormFactory = class(TActiveXControlFactory)
  399.   public
  400.     function GetIntfEntry(Guid: TGUID): PInterfaceEntry; override;
  401.   end;
  402.   {$EXTERNALSYM TActiveFormFactory}
  403.  
  404.   { Property Page support }
  405.  
  406.   TPropertyPageImpl = class;
  407.  
  408.   TPropertyPage = class(TCustomForm)
  409.   public
  410.     constructor Create(AOwner: TComponent); override;
  411.     destructor Destroy; override;
  412.     procedure Modified;
  413.     procedure UpdateObject; virtual;
  414.     procedure UpdatePropertyPage; virtual;
  415.     property OleObject: OleVariant;
  416.     property OleObjects: TInterfaceList;
  417.     procedure EnumCtlProps(PropType: TGUID; PropNames: TStrings);
  418.   published
  419.     property ActiveControl;
  420.     property AutoScroll;
  421.     property Caption;
  422.     property ClientHeight;
  423.     property ClientWidth;
  424.     property Ctl3D;
  425.     property Color;
  426.     property Enabled;
  427.     property Font;
  428.     property Height;
  429.     property HorzScrollBar;
  430.     property OldCreateOrder;
  431.     property KeyPreview;
  432.     property PixelsPerInch;
  433.     property ParentFont;
  434.     property PopupMenu;
  435.     property PrintScale;
  436.     property Scaled;
  437.     property ShowHint;
  438.     property VertScrollBar;
  439.     property Visible;
  440.     property Width;
  441.     property OnActivate;
  442.     property OnClick;
  443.     property OnClose;
  444.     property OnContextPopup;
  445.     property OnCreate;
  446.     property OnDblClick;
  447.     property OnDestroy;
  448.     property OnDeactivate;
  449.     property OnDragDrop;
  450.     property OnDragOver;
  451.     property OnHide;
  452.     property OnKeyDown;
  453.     property OnKeyPress;
  454.     property OnKeyUp;
  455.     property OnMouseDown;
  456.     property OnMouseMove;
  457.     property OnMouseUp;
  458.     property OnPaint;
  459.     property OnResize;
  460.     property OnShow;
  461.   end;
  462.  
  463.   TPropertyPageClass = class of TPropertyPage;
  464.  
  465.   TPropertyPageImpl = class(TAggregatedObject, IUnknown, IPropertyPage, IPropertyPage2)
  466.   protected
  467.     { IPropertyPage }
  468.     function SetPageSite(const pageSite: IPropertyPageSite): HResult; stdcall;
  469.     function Activate(hwndParent: HWnd; const rc: TRect; bModal: BOOL): HResult;
  470.       stdcall;
  471.     function Deactivate: HResult; stdcall;
  472.     function GetPageInfo(out pageInfo: TPropPageInfo): HResult; stdcall;
  473.     function SetObjects(cObjects: Longint; pUnkList: PUnknownList): HResult; stdcall;
  474.     function Show(nCmdShow: Integer): HResult; stdcall;
  475.     function Move(const rect: TRect): HResult; stdcall;
  476.     function IsPageDirty: HResult; stdcall;
  477.     function Apply: HResult; stdcall;
  478.     function Help(pszHelpDir: POleStr): HResult; stdcall;
  479.     function TranslateAccelerator(msg: PMsg): HResult; stdcall;
  480.     { IPropertyPage2 }
  481.     function EditProperty(dispid: TDispID): HResult; stdcall;
  482.   public
  483.     procedure InitPropertyPage; virtual;
  484.     property PropertyPage: TPropertyPage;
  485.   end;
  486.  
  487.   TActiveXPropertyPage = class(TComObject, IPropertyPage, IPropertyPage2)
  488.   public
  489.     destructor Destroy; override;
  490.     procedure Initialize; override;
  491.     property PropertyPageImpl: TPropertyPageImpl;
  492.   end;
  493.   {$EXTERNALSYM TActiveXPropertyPage}
  494.  
  495.   TActiveXPropertyPageFactory = class(TComObjectFactory)
  496.   public
  497.     constructor Create(ComServer: TComServerObject;
  498.       PropertyPageClass: TPropertyPageClass; const ClassID: TGUID);
  499.     function CreateComObject(const Controller: IUnknown): TComObject; override;
  500.   end;
  501.   {$EXTERNALSYM TActiveXPropertyPageFactory}
  502.  
  503.   { Type adapter support }
  504.  
  505.   TCustomAdapter = class(TInterfacedObject)
  506.   protected
  507.     Updating: Boolean;
  508.     procedure Changed; virtual;
  509.     procedure ConnectOleObject(OleObject: IUnknown);
  510.     procedure ReleaseOleObject;
  511.     procedure Update; virtual; abstract;
  512.   public
  513.     constructor Create;
  514.     destructor Destroy; override;
  515.   end;
  516.  
  517.   TAdapterNotifier = class(TInterfacedObject,
  518.     IPropertyNotifySink)
  519.   protected
  520.     { IPropertyNotifySink }
  521.     function OnChanged(dispid: TDispID): HResult; stdcall;
  522.     function OnRequestEdit(dispid: TDispID): HResult; stdcall;
  523.   public
  524.     constructor Create(Adapter: TCustomAdapter);
  525.   end;
  526.  
  527.   IFontAccess = interface
  528.     ['{CBA55CA0-0E57-11D0-BD2F-0020AF0E5B81}']
  529.     procedure GetOleFont(var OleFont: IFontDisp);
  530.     procedure SetOleFont(const OleFont: IFontDisp);
  531.   end;
  532.  
  533.   TFontAdapter = class(TCustomAdapter,
  534.     IChangeNotifier,
  535.     IFontAccess)
  536.   protected
  537.     { IFontAccess }
  538.     procedure GetOleFont(var OleFont: IFontDisp);
  539.     procedure SetOleFont(const OleFont: IFontDisp);
  540.     procedure Changed; override;
  541.     procedure Update; override;
  542.   public
  543.     constructor Create(Font: TFont);
  544.   end;
  545.  
  546.   IPictureAccess = interface
  547.     ['{795D4D31-43D7-11D0-9E92-0020AF3D82DA}']
  548.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  549.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  550.   end;
  551.  
  552.   TPictureAdapter = class(TCustomAdapter,
  553.     IChangeNotifier,
  554.     IPictureAccess)
  555.   protected
  556.     { IPictureAccess }
  557.     procedure GetOlePicture(var OlePicture: IPictureDisp);
  558.     procedure SetOlePicture(const OlePicture: IPictureDisp);
  559.     procedure Update; override;
  560.   public
  561.     constructor Create(Picture: TPicture);
  562.   end;
  563.  
  564.   TOleGraphic = class(TGraphic)
  565.   protected
  566.     procedure Changed(Sender: TObject); override;
  567.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  568.     function GetEmpty: Boolean; override;
  569.     function GetHeight: Integer; override;
  570.     function GetPalette: HPALETTE; override;
  571.     function GetTransparent: Boolean; override;
  572.     function GetWidth: Integer; override;
  573.     procedure SetHeight(Value: Integer); override;
  574.     procedure SetPalette(Value: HPALETTE); override;
  575.     procedure SetWidth(Value: Integer); override;
  576.   public
  577.     procedure Assign(Source: TPersistent); override;
  578.     procedure LoadFromFile(const Filename: string); override;
  579.     procedure LoadFromStream(Stream: TStream); override;
  580.     procedure SaveToStream(Stream: TStream); override;
  581.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  582.       APalette: HPALETTE); override;
  583.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  584.       var APalette: HPALETTE); override;
  585.     property MMHeight: Integer;      // in .01 mm units
  586.     property MMWidth: Integer;
  587.     property Picture: IPicture;
  588.   end;
  589.  
  590.   TStringsAdapter = class(TAutoIntfObject, IStrings, IStringsAdapter)
  591.   protected
  592.     { IStringsAdapter }
  593.     procedure ReferenceStrings(S: TStrings);
  594.     procedure ReleaseStrings;
  595.     { IStrings }
  596.     function Get_ControlDefault(Index: Integer): OleVariant; safecall;
  597.     procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
  598.     function Count: Integer; safecall;
  599.     function Get_Item(Index: Integer): OleVariant; safecall;
  600.     procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
  601.     procedure Remove(Index: Integer); safecall;
  602.     procedure Clear; safecall;
  603.     function Add(Item: OleVariant): Integer; safecall;
  604.     function _NewEnum: IUnknown; safecall;
  605.   public
  606.     constructor Create(Strings: TStrings);
  607.   end;
  608.  
  609.   TReflectorWindow = class(TWinControl)
  610.   protected
  611.     procedure CreateParams(var Params: TCreateParams); override;
  612.   public
  613.     constructor Create(ParentWindow: HWND; Control: TControl); reintroduce;
  614.   end;
  615.  
  616. procedure EnumDispatchProperties(Dispatch: IDispatch; PropType: TGUID;
  617.   VTCode: Integer; PropList: TStrings);
  618.  
  619. procedure GetOleFont(Font: TFont; var OleFont: IFontDisp);
  620. procedure SetOleFont(Font: TFont; OleFont: IFontDisp);
  621. procedure GetOlePicture(Picture: TPicture; var OlePicture: IPictureDisp);
  622. procedure SetOlePicture(Picture: TPicture; OlePicture: IPictureDisp);
  623. procedure GetOleStrings(Strings: TStrings; var OleStrings: IStrings);
  624. procedure SetOleStrings(Strings: TStrings; OleStrings: IStrings);
  625.  
  626. function ParkingWindow: HWND;
  627.  
  628. implementation
  629.